home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / ms_dos / lib / happysrc / pccall.c < prev    next >
Text File  |  1994-11-14  |  44KB  |  1,079 lines
  1. /*********************************************************************
  2.  *
  3.  *    *** HAPPy Pascal compiler ***
  4.  *
  5.  *      procedure or function call
  6.  *        (主に標準手続き､標準関数)
  7.  *
  8.  *     void call(Set fsys,ctp *fcp)
  9.  *
  10.  *        Copyright (c) H.Asano 1992-1994.
  11.  *
  12.  **********************************************************************/
  13.  
  14. #define EXTERN extern
  15. #include "pascomp.h"
  16. #include "pcpcd.h"
  17.  
  18. /***********************************/
  19. /* 標準手続き･標準関数名の識別子   */
  20. /***********************************/
  21. typedef enum stdpf
  22. {
  23.     /** 標準手続き **/
  24.              spWRITE,                   /* write                      */
  25.              spWRITELN,                 /* writeln                    */
  26.              spREAD,                    /* read                       */
  27.              spREADLN,                  /* readln                     */
  28.              spPAGE,                    /* page                       */
  29.              spGET,                     /* get                        */
  30.              spPUT,                     /* put                        */
  31.              spRESET,                   /* reset                      */
  32.              spREWRITE,                 /* rewrite                    */
  33.              spNEW,                     /* new                        */
  34.              spDISPOSE,                 /* dispose                    */
  35.              spPACK,                    /* pack                       */
  36.              spUNPACK,                  /* unpack                     */
  37.     /** 標準関数   **/
  38.              sfABS,                     /* abs                        */
  39.              sfSQR,                     /* sqr                        */
  40.              sfTRUNC,                   /* trunc                      */
  41.              sfROUND,                   /* round                      */
  42.              sfODD,                     /* odd                        */
  43.              sfORD,                     /* ord                        */
  44.              sfCHR,                     /* chr                        */
  45.              sfPRED,                    /* pred                       */
  46.              sfSUCC,                    /* succ                       */
  47.              sfEOLN,                    /* eoln                       */
  48.              sfEOF,                     /* eof                        */
  49.              sfSIN,                     /* sin                        */
  50.              sfCOS,                     /* cos                        */
  51.              sfEXP,                     /* exp                        */
  52.              sfSQRT,                    /* sqrt                       */
  53.              sfLN,                      /* ln                         */
  54.              sfARCTAN,                  /* arctan                     */
  55. } stdpf ;
  56.  
  57.  
  58. /********** 関数のプロトタイプ宣言 **********/
  59.  
  60. extern void calluser(Set,ctp*) ;
  61. extern void expression(Set) ;
  62. extern void selector(Set,ctp*) ;
  63. extern ctp  *searchid(Set)  ;
  64. extern Set  *mkset(Set*,int,...) ;
  65. extern Set  *orset(Set*,Set*);
  66. extern void enterid(ctp*)    ;
  67. extern ctp  *mkctp(char*,enum idclass,stp*,ctp*) ;
  68. extern void pcerr(int,char*) ;
  69. extern void insymbol(void)   ;
  70. extern boolean string(stp*)  ;
  71. extern boolean compatible(stp*,stp*) ;
  72. extern boolean assigncompati(stp*,stp*) ;
  73. extern void checkbounds(stp*,int) ;
  74. extern void getbounds(stp*,long*,long*) ;
  75. extern void constant(Set, stp**, union valu*);
  76. extern int align(stp*,int) ;
  77. extern void gen0(enum pcdmnc)     ;
  78. extern void genp(enum pcdmnc, int) ;
  79. extern void genq(enum pcdmnc, int) ;
  80. extern void gen0t(enum pcdmnc,stp*) ;
  81. extern void gen1t(enum pcdmnc,stp*,int) ;
  82. extern void gen2t(enum pcdmnc,stp*,int,int) ;
  83. extern void genldc(char,long) ;
  84. extern void genlda(int,int)   ;
  85. extern void genixa(long,int)  ;
  86. extern void genchk(stp*,int,long,long) ;
  87. extern void convertint(stp*)  ;
  88. extern void load(void) ;
  89. extern void loadaddress(void) ;
  90. extern void store(attr) ;
  91. extern void skip(Set) ;
  92.  
  93. static void pwrite(char*,Set,stdpf) ;
  94. static void textwrite(Set,char*,attr)    ;
  95. static void nottextwrite(Set,char*,attr) ;
  96. static void pread(char*,Set,stdpf)  ;
  97. static void nottextread(Set,char*,attr)  ;
  98. static void ppage(char*,Set) ;
  99. static void pgetputrstrwt(char*,Set,stdpf);
  100. static void pnewdis(char*,Set,stdpf);
  101. static void ppack(char*,Set) ;
  102. static void punpack(char*,Set) ;
  103. static void variable(Set)   ;
  104. static void fabs(char*) ;
  105. static void fsqr(char*) ;
  106. static void ftrunc(char*) ;
  107. static void fround(char*) ;
  108. static void fodd(char*) ;
  109. static void ford(char*) ;
  110. static void fchr(char*) ;
  111. static void fpredsucc(char*,stdpf) ;
  112. static void feofeoln(char*,Set,stdpf)   ;
  113. static void fcalc(char*,stdpf) ;
  114. static void enterstdpf_sub(char*,enum idclass,stp*,stdpf) ;
  115.  
  116. static attr inputattr  ;                /* input ファイル省略時に使用 */
  117. static attr outputattr ;                /* outputファイル省略時に使用 */
  118.  
  119. /**********************************************************************/
  120.  
  121. /***************************************/
  122. /*  call() : 手続き･関数の呼出処理     */
  123. /***************************************/
  124. void call(Set fsys,ctp *fcp)
  125. {
  126.   int lkey ;
  127.   char *name ;                          /* 手続き名(エラーメッセージ用)*/
  128.   Set ws   ;
  129.  
  130.      if(fcp->n.pf.pfdeckind == standard) {  /* 標準手続きor標準関数の時 */
  131.       lkey = fcp->n.pf.sd.key ;
  132.       name = fcp->name        ;
  133.       if(fcp->klass == proc) {          /* 手続きの時                 */
  134.        mkset(&ws,spWRITE,spWRITELN,spREAD,spREADLN,spPAGE,-1);
  135.        if(! inset(ws,lkey))      /* write,writeln,read,readln,page以外*/
  136.         if(sy == lparent) insymbol() ;
  137.         else pcerr(9,"") ;              /* ( がない                   */
  138.  
  139.        switch(lkey) {
  140.         case spWRITE   :
  141.         case spWRITELN :  pwrite(name,fsys,lkey) ;  break ;
  142.         case spREAD    :
  143.         case spREADLN  :  pread(name,fsys,lkey) ;   break ;
  144.         case spPAGE    :  ppage(name,fsys) ;        break ;
  145.         case spGET     :
  146.         case spPUT     :
  147.         case spRESET   :
  148.         case spREWRITE :  pgetputrstrwt(name,fsys,lkey) ;  break ;
  149.         case spNEW     :
  150.         case spDISPOSE :  pnewdis(name,fsys,lkey) ;  break ;
  151.         case spPACK    :  ppack(name,fsys) ;  break ;
  152.         case spUNPACK  :  punpack(name,fsys) ; break ;
  153.        }
  154.  
  155.        if(! inset(ws,lkey))      /* write,writeln,read,readln,page以外*/
  156.         if(sy == rparent) insymbol() ;
  157.         else pcerr(4,"") ;              /* ) がない　                 */
  158.       }
  159.  
  160.       else {                            /* 標準関数の時               */
  161.        ws = fsys ;
  162.        addset(ws,rparent) ;
  163.        if((lkey != sfEOLN) && (lkey != sfEOF)) { /* eoln,eof以外は(がある*/
  164.         if(sy == lparent) insymbol() ;
  165.         else pcerr(9,"") ;              /* ( がない                   */
  166.         expression(ws)   ;              /* 引数の処理                 */
  167.         load()           ;              /* 引数をload                 */
  168.        }
  169.  
  170.        switch(lkey) {                   /* 関数により振り分ける       */
  171.         case sfABS  : fabs(name)   ; break;
  172.         case sfSQR  : fsqr(name)   ; break;
  173.         case sfTRUNC: ftrunc(name) ; break;
  174.         case sfROUND: fround(name) ; break;
  175.         case sfODD  : fodd(name)   ; break;
  176.         case sfORD  : ford(name)   ; break;
  177.         case sfCHR  : fchr(name)   ; break;
  178.         case sfPRED :
  179.         case sfSUCC : fpredsucc(name,lkey)   ; break;
  180.         case sfEOLN :
  181.         case sfEOF  : feofeoln(name,ws,lkey) ; break;
  182.         case sfSIN  :
  183.         case sfCOS  :
  184.         case sfEXP  :
  185.         case sfSQRT :
  186.         case sfLN   :
  187.         case sfARCTAN: fcalc(name,lkey) ;break;  /* 算術関数          */
  188.        }
  189.  
  190.        if((lkey != sfEOLN) && (lkey != sfEOF))  /* eoln,eof以外は)がある*/
  191.         if(sy == rparent) insymbol() ;
  192.         else pcerr(4,"") ;              /* ) がない                   */
  193.  
  194.       }
  195.      }
  196.  
  197.      else calluser(fsys,fcp) ;          /* ユーザ定義の手続き･関数を呼ぶ*/
  198. }
  199.  
  200. /*****************************************/
  201. /* cspfile():ファイル入出力関係の命令生成*/
  202. /*    以下の命令はこれを使わない         */
  203. /*         (wrs,put,get,rst,rwt)         */
  204. /*****************************************/
  205. static void cspfile(attr fattr,enum pcdmnc mnc)
  206. {
  207.   int p = 2 ;                           /* 一般ファイルとしておく     */
  208.  
  209.      if(fattr.access == drct)           /* ファイル変数が実変数の時   */
  210.       switch(fattr.dplmt) {
  211.        case inputadr  : p=0 ; break ;   /* input ファイルへのアクセス */
  212.        case outputadr : p=1 ; break ;   /* outputファイルへのアクセス */
  213.        default        : genq(iLAO,fattr.dplmt) ;
  214.       }
  215.      else                               /* ファイル変数が変数引数     */
  216.       gen2t(iLOD,nilptr,level-fattr.vlevel,fattr.dplmt) ;
  217.  
  218.      genp(mnc,p) ;                       /* 命令生成                  */
  219. }
  220.  
  221. /******************************************/
  222. /*  loadfilead() : ファイルアドレスロード */
  223. /******************************************/
  224. static void loadfilead(attr bufattr)
  225. {
  226.      if(bufattr.access == drct)         /* ファイル変数が実変数の時   */
  227.       genq(iLAO,bufattr.dplmt) ;        /* HAPPyでは大域変数しかない  */
  228.      else                               /* ファイル変数が変数引数     */
  229.       gen2t(iLOD,nilptr,level-bufattr.vlevel,bufattr.dplmt) ;
  230. }
  231.  
  232. /***************************************/
  233. /* pwrite() : write/writeln手続きの処理*/
  234. /***************************************/
  235. void pwrite(char *name,Set fsys,stdpf fkey)
  236. {
  237.   stp *lsp ;
  238.   attr fileattr ;
  239.   boolean test ;
  240.   boolean textflag;
  241.   Set ws,ws1 ;
  242.  
  243.      fileattr = outputattr  ;           /* outputファイル省略時の属性 */
  244.      textflag = true    ;
  245.      mkset(&ws,comma,colon,rparent,-1) ;
  246.      orset(&ws,&fsys) ;
  247.  
  248.      if(sy == lparent) {                /* ( がきたら引数がある       */
  249.       insymbol() ;
  250.       expression(ws) ;                  /* 最初の式                   */
  251.       lsp = gattr.typtr ;
  252.       test = false ;
  253.       if(lsp)
  254.        if(lsp->form == files) {         /***** ファイル変数の処理 *****/
  255.         fileattr = gattr ;              /* ファイル変数の属性を退避   */
  256.         if(!lsp->sf.fi.texttype) {      /*テキストファイルでない      */
  257.          textflag = false ;
  258.          if(fkey == spWRITELN) pcerr(116,name) ;/* writelnはテキストのみ*/
  259.         }
  260.  
  261.         if(sy == rparent) {
  262.          if(fkey == spWRITE) pcerr(116,name) ; /* writeの時は)は駄目  */
  263.          test = true ;                  /* 処理終わり                 */
  264.         }
  265.         else if(sy == comma) {          /* ファイル変数に次ぐ文字が , */
  266.          if(!textflag)
  267.           loadfilead(fileattr);         /*  バッファ変数アドレスロード*/
  268.          insymbol() ;
  269.          expression(ws) ;               /* 出力対象式                 */
  270.         }
  271.         else {                          /* ) , 以外                   */
  272.          pcerr(116,name);               /* 標準手続きの引数に誤り     */
  273.          mkset(&ws1,comma,rparent);
  274.          orset(&ws1,&fsys);
  275.          skip(ws1) ;                    /* 読み飛ばし                 */
  276.         }
  277.        }
  278.        else if(!defineoutput) pcerr(301,name) ; /* ファイル変数省略時
  279.                                                   outputが未定義ならエラー*/
  280.  
  281.       if(! test)
  282.        if(textflag)
  283.         textwrite(ws,name,fileattr);        /*  出力対象式の処理      */
  284.        else
  285.         nottextwrite(fsys,name,fileattr);   /* テキスト以外への出力   */
  286.  
  287.       if(sy == rparent) insymbol() ;
  288.       else pcerr(4,"") ;
  289.      }
  290.  
  291.      else                               /* (がない ･･･ 引数がない     */
  292.       if(fkey == spWRITE) pcerr(116,name) ;   /* writeは必ず引数が必要*/
  293.       else if(!defineoutput) pcerr(301,name) ;/* output未定義は駄目   */
  294.  
  295.      if(fkey == spWRITELN)
  296.       cspfile(fileattr,iWLN) ;
  297. }
  298.  
  299. /***************************************/
  300. /* textwrite() : text型への出力        */
  301. /***************************************/
  302. static void textwrite(Set fsys,char *fname,attr fattr)
  303. {
  304.   stp *lsp;
  305.   int len ;
  306.   int p   ;                             /* p operand                  */
  307.   boolean defaultcolum  ;               /* default 桁数の時 true      */
  308.   boolean test          ;
  309.  
  310.      do {
  311.       defaultcolum = true ;
  312.  
  313.       lsp = gattr.typtr ;
  314.       if(lsp)
  315.        (lsp->form <= subrange) ? load() : loadaddress() ;
  316.  
  317.        if(sy==colon) {                  /* 桁数指定がある時           */
  318.         insymbol() ;                    /* 桁数を読む                 */
  319.         expression(fsys) ;              /* 桁数の処理                 */
  320.         if(gattr.typtr)
  321.          if(gattr.typtr != intptr)
  322.           pcerr(116,fname) ;            /* 標準手続きの引数の型誤り   */
  323.          load() ;                       /* 桁数をload                 */
  324.          defaultcolum = false ;         /* 桁数指定あり               */
  325.        }
  326.  
  327.        if(lsp == intptr) {              /* 整数型                     */
  328.         if(defaultcolum) genldc('i',12L); /* 桁数省略時  12桁         */
  329.         cspfile(fattr,iWRI) ;
  330.        }
  331.        else if(lsp == realptr) {        /* 実数型                     */
  332.         if(sy!=colon) {                 /* 固定少数点指定でない時     */
  333.          if(defaultcolum) genldc('i',14L) ; /* 桁数省略時 14桁        */
  334.           cspfile(fattr,iWRR) ;         /*  wrr  (浮動小数点出力)     */
  335.         }
  336.         else {                          /* 固定小数点出力             */
  337.          insymbol() ;                   /* 桁数を読む                 */
  338.          expression(fsys) ;             /* 桁数の処理                 */
  339.          if(gattr.typtr)
  340.           if(gattr.typtr != intptr)
  341.            pcerr(116,fname) ;           /* 標準手続きの引数の型誤り   */
  342.          load() ;                       /* 桁数をload                 */
  343.          cspfile(fattr,iWRF) ;          /* wrf  (固定少数点出力)      */
  344.         }
  345.        }
  346.        else if(lsp == charptr) {        /* 文字型                     */
  347.         if(defaultcolum) genldc('i',1L);/* 桁数省略時 1桁             */
  348.         cspfile(fattr,iWRC) ;
  349.        }
  350.        else if(string(lsp)) {           /* 文字列型                   */
  351.         len = lsp->size / charmax ;
  352.         if(defaultcolum) genldc('i',(long)len); /* 省略時 文字列の桁数*/
  353.         p = 2 ;                         /* 一般ファイルとしておく     */
  354.         if(fattr.access == drct)        /* ファイル変数が実変数の時   */
  355.          if(fattr.dplmt == outputadr)
  356.           p = 1 ;                       /* outputファイル表示         */
  357.          else
  358.           genq(iLAO,fattr.dplmt) ;      /* HAPPyでは大域変数しかない  */
  359.         else                            /* ファイル変数が変数引数     */
  360.          gen2t(iLOD,nilptr,level-fattr.vlevel,fattr.dplmt) ;
  361.         gen2t(iWRS,nil,p,len) ;         /* wrs命令生成　 q･･･ 文字列長*/
  362.        }
  363.        else if(lsp == boolptr) {        /* boolean型                  */
  364.         if(defaultcolum) genldc('i',5L);/* 桁数省略時  5桁            */
  365.         cspfile(fattr,iWRB) ;
  366.        }
  367.        else pcerr(116,fname) ;          /* 標準関数の引数の型の誤り   */
  368.  
  369.        if(test = (sy == comma)) {
  370.        insymbol() ;
  371.        expression(fsys) ;               /* 次の出力対象式             */
  372.       }
  373.      } while(test) ;                    /* , なら繰り返す             */
  374. }
  375.  
  376. /*****************************************/
  377. /* nottextwrite() : テキスト型以外の出力 */
  378. /*****************************************/
  379. static void nottextwrite(Set fsys,char *fname,attr bufattr)
  380. {
  381.   boolean test  ;
  382.   Set ws ;
  383.  
  384.      bufattr.typtr = bufattr.typtr->sf.fi.filtype;/* バッファ変数の型 */
  385.      mkset(&ws,comma,rparent,-1);
  386.      orset(&ws,&fsys) ;
  387.  
  388.      do {
  389.       if(gattr.typtr) {
  390.        if(gattr.typtr->form <= power)   /* スカラー､範囲､ポインタ､集合*/
  391.         load() ;
  392.        else loadaddress() ;
  393.  
  394.        if((bufattr.typtr == realptr) &&      /* バッファ変数がreal    */
  395.           (compatible(gattr.typtr,intptr))){ /* 書くものが整数型の時  */
  396.         gen0(iFLT) ;                         /* 実数に変換 flt命令    */
  397.         gattr.typtr = realptr ;
  398.        }
  399.  
  400.        if(assigncompati(bufattr.typtr,gattr.typtr)) /* ﾊﾞｯﾌｧ変数に代入可能 */
  401.         switch(bufattr.typtr->form) {   /* 型によって振り分ける       */
  402.          case scalar   :
  403.          case subrange :
  404.            checkbounds(bufattr.typtr,18) ; /* 上限･下限のチェック     */
  405.            store(bufattr) ;
  406.            break ;
  407.          case pointer  :
  408.            store(bufattr) ;
  409.            break ;
  410.          case power :
  411.            checkbounds(bufattr.typtr,72) ; /* 上限･下限のチェック     */
  412.            store(bufattr) ;
  413.            break ;
  414.          case arrays  :
  415.          case records :
  416.            gen2t(iMOV,nil,1,bufattr.typtr->size) ;
  417.            break ;
  418.          case files :
  419.            pcerr(116,fname) ;           /* 標準手続きの引数誤り       */
  420.         }
  421.        else pcerr(116,fname) ;          /* 代入可能でない場合         */
  422.  
  423.        loadfilead(bufattr) ;            /* ファイル変数アドレスロード */
  424.        gen0(iPUT) ;                     /* 命令生成                   */
  425.       }
  426.  
  427.       if(test = (sy == comma)) {
  428.        loadfilead(bufattr) ;            /* バッファ変数アドレスロード */
  429.        insymbol() ;
  430.        expression(ws) ;                 /* 次の出力対象式             */
  431.       }
  432.      } while(test) ;                    /* , なら繰り返す             */
  433. }
  434.  
  435. /***************************************/
  436. /* pread() : read/readln手続きの処理   */
  437. /***************************************/
  438. static void pread(char* name,Set fsys,stdpf fkey)
  439. {
  440.   stp *lsp ;
  441.   attr fileattr ;
  442.   boolean textflag ;
  443.   boolean test ;
  444.   Set ws ;
  445.  
  446.      fileattr = inputattr ;             /* inputファイル省略時の属性  */
  447.      textflag = true   ;
  448.      mkset(&ws,comma,rparent,-1) ;
  449.      orset(&ws,&fsys) ;
  450.  
  451.      if(sy == lparent) {                /* ( がきたら引数がある       */
  452.       insymbol() ;
  453.       variable(ws) ;                    /* 最初の変数                 */
  454.       lsp = gattr.typtr;
  455.       test = false ;
  456.       if(lsp)
  457.        if(lsp->form == files) {         /****** file 変数の処理 *******/
  458.         fileattr = gattr ;              /* ファイル変数の属性を退避   */
  459.         if(!lsp->sf.fi.texttype)  {     /* textファイル以外           */
  460.          textflag = false ;
  461.          if(fkey == spREADLN) pcerr(116,name) ;/* readlnはテキストのみ*/
  462.         }
  463.         if(sy == rparent) {
  464.          if(fkey == spREAD) pcerr(116,name) ; /* readの時は)は駄目    */
  465.          test = true ;                  /* 処理終わり                 */
  466.         }
  467.         else if(sy != comma) {          /* ファイル変数に次ぐ文字が,でない*/
  468.          pcerr(116,name);               /* 標準手続きの引数に誤り     */
  469.          skip(ws) ;                     /* 読み飛ばし                 */
  470.         }
  471.         if(sy == comma) {
  472.          insymbol() ;
  473.          variable(ws) ;                 /* ,に続く変数の処理          */
  474.         }
  475.         else test = true ;              /* ) の時                     */
  476.        }
  477.        else if(!defineinput) pcerr(300,name) ; /* ファイル変数省略時
  478.                                                Inputが未定義ならエラー*/
  479.  
  480.       if(! test)                        /**** 読込対象変数の処理 ******/
  481.        if(textflag)                     /* テキストファイルの時       */
  482.         do {
  483.          loadaddress() ;
  484.  
  485.          if(gattr.typtr)
  486.           if(gattr.typtr->form <= subrange)
  487.            if(compatible(intptr,gattr.typtr))
  488.             cspfile(fileattr,iRDI) ;    /* integer型なら  rdi         */
  489.            else if(realptr == gattr.typtr)
  490.             cspfile(fileattr,iRDR) ;    /*  real型なら    rdr         */
  491.            else if(compatible(charptr,gattr.typtr))
  492.             cspfile(fileattr,iRDC) ;    /*  char型なら    rdc         */
  493.            else pcerr(116,name) ;       /* 引数の型に誤り             */
  494.           else  pcerr(116,name) ;       /* 引数の型に誤り             */
  495.  
  496.           if(test = (sy == comma)) {
  497.           insymbol() ;
  498.           variable(ws) ;                /* 次の変数の処理             */
  499.           }
  500.         } while(test) ;
  501.        else nottextread(fsys,name,fileattr); /* テキスト以外の入力    */
  502.  
  503.       if(sy == rparent) insymbol() ;
  504.       else pcerr(4,"") ;
  505.      }
  506.      else
  507.       if(fkey == spREAD)    pcerr(116,name) ;
  508.       else if(!defineinput) pcerr(300,name) ; /* readlnで引数がなく
  509.                                                   input未定義は駄目   */
  510.  
  511.      if(fkey == spREADLN)               /* readln関数の時             */
  512.       cspfile(fileattr,iRLN) ;          /*  csp rln                   */
  513. }
  514.  
  515. /*****************************************/
  516. /* nottextread() : テキスト型以外の入力  */
  517. /*****************************************/
  518. static void nottextread(Set fsys,char *fname,attr bufattr)
  519. {
  520.   boolean test ;
  521.   Set ws ;
  522.  
  523.      bufattr.typtr = bufattr.typtr->sf.fi.filtype ; /*バッファ変数の型*/
  524.      mkset(&ws,comma,rparent,-1);
  525.      orset(&ws,&fsys) ;
  526.  
  527.      do {
  528.       if(gattr.typtr) {
  529.        if((gattr.access != drct) ||     /* 直接参照でないか           */
  530.           (gattr.typtr->form > power))  /* 配列型､レコード型､ファイル型*/
  531.        loadaddress() ;                  /* の時は、アドレスをのせる   */
  532.        if(bufattr.access == drct)       /* ファイル変数が実変数       */
  533.         if(bufattr.typtr->form<=power)  /* スカラ,範囲,ポインタ,集合  */
  534.          gen1t(iLDO,bufattr.typtr,bufattr.dplmt); /* バッファ変数ﾛｰﾄﾞ */
  535.         else genq(iLAO,bufattr.dplmt) ;
  536.        else {                           /* ファイル変数が変数引数     */
  537.         gen2t(iLOD,nilptr,level-bufattr.vlevel,bufattr.dplmt) ;
  538.         if(bufattr.typtr->form <= power)/* スカラ,範囲,ポインタ,集合  */
  539.          gen1t(iIND,bufattr.typtr,0) ;  /* ind命令で値をロード        */
  540.        }
  541.        if((gattr.typtr == realptr) &&          /* 読む変数がreal      */
  542.           (compatible(bufattr.typtr,intptr))){ /* ﾊﾞｯﾌｧ変数が整数型の */
  543.         gen0(iFLT) ;                           /* 実数に変換 flt命令  */
  544.         gattr.typtr = realptr ;
  545.        }
  546.  
  547.        if(assigncompati(gattr.typtr,bufattr.typtr)) /* 代入可能ﾁｪｯｸ   */
  548.         switch(gattr.typtr->form) {     /* 型によって振り分ける       */
  549.          case scalar   :
  550.          case subrange :
  551.            checkbounds(gattr.typtr,17) ;/* 上限･下限のチェック        */
  552.            store(gattr) ;
  553.            break ;
  554.          case pointer  :
  555.            store(gattr) ;
  556.            break ;
  557.          case power :
  558.            checkbounds(gattr.typtr,71) ;/* 上限･下限のチェック        */
  559.            store(gattr) ;
  560.            break ;
  561.          case arrays  :
  562.          case records :
  563.            gen2t(iMOV,nil,1,gattr.typtr->size) ;
  564.            break ;
  565.          case files :
  566.            pcerr(116,fname) ;           /* 標準手続きの引数誤り       */
  567.         }
  568.        else pcerr(116,fname) ;          /* 代入可能でない場合         */
  569.  
  570.        loadfilead(bufattr) ;             /* ファイル変数アドレスロード */
  571.        gen0(iGET) ;                      /* get命令生成               */
  572.       }
  573.  
  574.       if(test = (sy == comma)) {
  575.        insymbol() ;
  576.        variable(ws) ;                 /* 次の出力対象式               */
  577.       }
  578.      } while(test) ;                  /* , なら繰り返す               */
  579. }
  580.  
  581. /***************************************/
  582. /* ppage() : page手続きの処理          */
  583. /***************************************/
  584. static void ppage(char* name,Set fsys)
  585. {
  586.   Set  ws    ;
  587.  
  588.      ws = fsys ;
  589.      addset(ws,rparent) ;
  590.  
  591.      if(sy == lparent)  {               /* 引数がある時               */
  592.       insymbol()   ;
  593.       variable(ws) ;                    /* ファイル変数               */
  594.       if(gattr.typtr != textptr)        /* テキストファイルでなければ */
  595.        pcerr(116,name) ;                /* 標準手続きの引数誤り       */
  596.       if(sy == rparent) insymbol() ;
  597.       else pcerr(4,"") ;                /* )がない                    */
  598.      }
  599.      else {                             /* 引数がない時               */
  600.       if(!defineoutput) pcerr(301,name);/* outputファイル未定義       */
  601.       gattr = outputattr ;
  602.      }
  603.  
  604.      cspfile(gattr,iPGE) ;
  605. }
  606.  
  607. /***********************************************************/
  608. /* pgetputrstrwt() : get/put/reset/rewrite手続きの処理     */
  609. /***********************************************************/
  610. static void pgetputrstrwt(char *name,Set fsys,stdpf fkey)
  611. {
  612.   enum pcdmnc opname ;                  /* オペレーション名           */
  613.   Set ws ;
  614.  
  615.      ws = fsys ;
  616.      addset(ws,rparent) ;
  617.      variable(ws) ;                     /* ファイル変数               */
  618.  
  619.      if(gattr.typtr)
  620.       if(gattr.typtr->form != files)    /* ファイル変数でない         */
  621.        pcerr(116,name) ;                /* 標準手続きの引数誤り       */
  622.       else
  623.        if(gattr.typtr == textptr) {     /* テキストファイルの時       */
  624.         switch(fkey) {
  625.          case spGET    : opname = iTGT ; break ;
  626.          case spPUT    : opname = iTPT ; break ;
  627.          case spRESET  : opname = iTRS ; break ;
  628.          case spREWRITE: opname = iTRW ; break ;
  629.         }
  630.         cspfile(gattr,opname) ;         /* 命令生成                   */
  631.        }
  632.        else {                           /* テキストファイル以外の時   */
  633.         switch(fkey) {
  634.          case spGET    : opname = iGET ; break ;
  635.          case spPUT    : opname = iPUT ; break ;
  636.          case spRESET  : opname = iRST ; break ;
  637.          case spREWRITE: opname = iRWT ; break ;
  638.         }
  639.         loadfilead(gattr) ;             /* ファイル変数アドレスロード */
  640.         gen0(opname) ;
  641.        }
  642. }
  643.  
  644. /***************************************/
  645. /* pnewdis() : new/dispose手続きの処理 */
  646. /***************************************/
  647. static void pnewdis(char *name,Set fsys,stdpf fkey)
  648. {
  649.   stp *lsp = nil;
  650.   stp *lsp1     ;
  651.   stp *lspconst ;                       /* 定数の型                   */
  652.   union valu lval ;                     /* 定数の値                   */
  653.   int lsize = 0 ;                       /* 確保･解放するエリアサイズ  */
  654.   Set ws ;
  655.  
  656.      mkset(&ws,rparent,comma,-1);
  657.      orset(&ws,&fsys) ;
  658.      if(fkey == spNEW) {
  659.       variable(ws)  ;                   /* newは引数変数の処理        */
  660.       loadaddress() ;
  661.      }
  662.      else {
  663.       expression(ws);                   /* disposeは式が許される　    */
  664.       load() ;
  665.      }
  666.  
  667.      if(gattr.typtr)
  668.       if(gattr.typtr->form == pointer) {
  669.        if(gattr.typtr->sf.pt.eltype) {  /* 指し示す物の型がある       */
  670.         lsize = gattr.typtr->sf.pt.eltype->size ;
  671.         if(gattr.typtr->sf.pt.eltype->form == records)
  672.          lsp = gattr.typtr->sf.pt.eltype->sf.re.recvar ; /* 可変部    */
  673.        }
  674.       }
  675.       else pcerr(116,name) ;            /* 標準手続きの引数の型に誤り */
  676.  
  677.      while(sy == comma) {               /* 定数の指定がある時         */
  678.       insymbol() ;
  679.       constant(ws,&lspconst,&lval)  ;
  680.       if(string(lspconst) || (lspconst==realptr)) /* 文字列､実数型    */
  681.        pcerr(159,"") ;                  /* 文字列､実数型は指定不可    */
  682.       if(!lsp) pcerr(162,"")  ;        /* 該当する可変要素選択子がない*/
  683.       else if((lsp->form == tagfld) &&
  684.               (lsp->sf.tg.tagtype)) {   /* 可変部がある場合           */
  685.        if(compatible(lsp->sf.tg.tagtype,lspconst)) { /* 型が適合する  */
  686.         if(lsp->sf.tg.tagtype->form == subrange)
  687.          if((lval.ival < lsp->sf.tg.tagtype->sf.su.min) ||
  688.             (lval.ival > lsp->sf.tg.tagtype->sf.su.max))  /* 範囲外   */
  689.           pcerr(162,"") ;              /* 該当する可変要素選択子がない*/
  690.         lsp1 = lsp->sf.tg.fstvar ;
  691.         while(lsp1) {                   /* 該当する可変要素を探す     */
  692.          if(lsp1->sf.vr.varval == lval.ival) {  /* 必ず一致するものがある*/
  693.           lsize = lsp1->size ;
  694.           break ;
  695.          }
  696.          else lsp1 = lsp1->sf.vr.nextvr ;
  697.         }
  698.        }
  699.        else pcerr(162,"") ;             /* 該当する可変要素選択子がない*/
  700.        lsp   = lsp1->sf.vr.subvar ;     /* 配下の可変部               */
  701.       }
  702.       else pcerr(162,"") ;              /* 該当する可変要素選択子がない*/
  703.      }
  704.  
  705.      if(fkey == spNEW) genq(iNEW,lsize);/* new                        */
  706.      else              genq(iDIS,lsize);/* dis                        */
  707. }
  708.  
  709. /***************************************/
  710. /*     ppack() : pack手続きの処理      */
  711. /***************************************/
  712. static void ppack(char *name,Set fsys)
  713. {
  714.   stp *lspuinx=nil;                      /* 詰めなし配列の添え字の型   */
  715.   stp *lspuael=nil;                      /* 詰めなし配列の要素の型     */
  716.   long lmin,lmax  ;
  717.   int  lsize      ;
  718.   Set ws ;
  719.  
  720.      mkset(&ws,comma,rparent,-1);
  721.      orset(&ws,&fsys);
  722.      variable(ws) ;                     /* 詰めなし配列               */
  723.      if(gattr.typtr)
  724.       if((gattr.typtr->form == arrays)  /* 詰めなし配列チェック       */
  725.       && (!gattr.typtr->sf.ar.packed)) {
  726.        lspuinx = gattr.typtr->sf.ar.inxtype;
  727.        lspuael = gattr.typtr->sf.ar.aeltype;
  728.        loadaddress() ;                  /* 転送元アドレスをロード     */
  729.       }
  730.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  731.      if(sy == comma) insymbol() ;
  732.  
  733.      expression(ws) ;                   /* 詰めなし配列の添え字式     */
  734.      if(gattr.typtr)
  735.       if((gattr.typtr->form  == scalar)
  736.       && (compatible(gattr.typtr,lspuinx))) { /* 型が適合すること     */
  737.        load() ;                         /* 式の値をロード             */
  738.        convertint(gattr.typtr) ;        /* 必要ならord命令生成        */
  739.        getbounds(lspuinx,&lmin,&lmax) ; /* 添え字の範囲を調べる       */
  740.        if(debug) genchk(intptr,26,lmin,lmax) ; /* chk命令を生成       */
  741.        lsize = lspuael->size ;
  742.        lsize = align(lspuael,lsize) ;   /* 境界合わせ                 */
  743.        genixa(lmin,lsize) ;             /* ixa命令生成                */
  744.       }
  745.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  746.      if(sy == comma) insymbol() ;
  747.  
  748.      ws = fsys;
  749.      addset(ws,rparent) ;
  750.      variable(ws) ;                     /* 詰め込み配列               */
  751.      if(gattr.typtr)
  752.       if((gattr.typtr->form == arrays)  /* 詰め込み配列チェック       */
  753.       && (gattr.typtr->sf.ar.packed)
  754.       && (compatible(gattr.typtr->sf.ar.inxtype,lspuinx))
  755.       && (compatible(gattr.typtr->sf.ar.aeltype,lspuael))) {
  756.        loadaddress() ;                  /* 転送先アドレスをロード     */
  757.        gen2t(iMOV,nil,2,gattr.typtr->size) ; /* mov 2命令             */
  758.       }
  759.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  760. }
  761.  
  762. /***************************************/
  763. /*     punpack() : unpack手続きの処理  */
  764. /***************************************/
  765. static void punpack(char *name,Set fsys)
  766. {
  767.   stp *lsppinx=nil;                     /* 詰めあり配列の添え字の型   */
  768.   stp *lsppael=nil;                     /* 詰めあり配列の要素の型     */
  769.   stp *lspuinx=nil;                     /* 詰めなし配列の添え字の型   */
  770.   stp *lspuael=nil;                     /* 詰めなし配列の要素の型     */
  771.   long lmin,lmax  ;
  772.   int  lsize      ;
  773.   int  movleng    ;                     /* 転送長                     */
  774.   Set ws ;
  775.  
  776.      mkset(&ws,comma,rparent,-1);
  777.      orset(&ws,&fsys);
  778.      variable(ws) ;                     /* 詰めあり配列               */
  779.      if(gattr.typtr)
  780.       if((gattr.typtr->form == arrays)  /* 詰めあり配列チェック       */
  781.       && (gattr.typtr->sf.ar.packed)) {
  782.        lsppinx = gattr.typtr->sf.ar.inxtype;
  783.        lsppael = gattr.typtr->sf.ar.aeltype;
  784.        movleng = gattr.typtr->size ;
  785.        loadaddress() ;                  /* 転送元アドレスをロード     */
  786.       }
  787.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  788.      if(sy == comma) insymbol() ;
  789.  
  790.      variable(ws) ;                     /* 詰めなし配列               */
  791.      if(gattr.typtr)
  792.       if((gattr.typtr->form == arrays)  /* 詰めなし配列チェック       */
  793.       && (!gattr.typtr->sf.ar.packed)
  794.       && (compatible(gattr.typtr->sf.ar.inxtype,lsppinx))
  795.       && (compatible(gattr.typtr->sf.ar.aeltype,lsppael))) {
  796.        lspuinx = gattr.typtr->sf.ar.inxtype;
  797.        lspuael = gattr.typtr->sf.ar.aeltype;
  798.        loadaddress() ;                  /* 基底アドレスをロード       */
  799.       }
  800.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  801.      if(sy == comma) insymbol() ;
  802.  
  803.      ws = fsys;
  804.      addset(ws,rparent) ;
  805.      expression(ws) ;                   /* 詰めなし配列の添え字式     */
  806.      if(gattr.typtr)
  807.       if((gattr.typtr->form  == scalar)
  808.       && (compatible(gattr.typtr,lspuinx))) { /* 型が適合すること     */
  809.        load() ;                         /* 式の値をロード             */
  810.        convertint(gattr.typtr) ;        /* 必要ならord命令生成        */
  811.        getbounds(lspuinx,&lmin,&lmax) ; /* 添え字の範囲を調べる       */
  812.        if(debug) {
  813.         genchk(intptr,29,lmin,lmax) ;   /* chk命令を生成              */
  814.         genldc('i',(long)(movleng-1));  /* 転送長-1                   */
  815.         gen0(iADI) ;                    /* 転送後の配列添え字         */
  816.         genchk(intptr,31,lmin,lmax) ;   /* 添え字範囲内か             */
  817.         genldc('i',(long)(movleng-1));
  818.         gen0(iSBI) ;                    /* もとに戻す                 */
  819.        }
  820.        lsize = lsppael->size ;
  821.        lsize = align(lsppael,lsize) ;   /* 境界合わせ                 */
  822.        genixa(lmin,lsize) ;             /* ixa命令生成                */
  823.        gen2t(iMOV,nil,2,movleng) ;      /* mov 2命令                  */
  824.       }
  825.       else pcerr(116,name) ;            /* 標準手続きの引き数の型誤り */
  826. }
  827.  
  828. /***************************************/
  829. /*     fabs() : abs関数の処理          */
  830. /***************************************/
  831. static void fabs(char *name)
  832. {
  833.      if(gattr.typtr)
  834.       if(gattr.typtr == intptr)       gen0(iABI) ;  /* integerならabi */
  835.       else if(gattr.typtr == realptr) gen0(iABR) ;  /* real   ならabr */
  836.       else {
  837.        pcerr(125,name) ;                /* 標準関数の引数の型に誤り   */
  838.        gattr.typtr = intptr ;
  839.       }
  840. }
  841.  
  842. /***************************************/
  843. /*     fsqr() : sqr関数の処理          */
  844. /***************************************/
  845. static void fsqr(char *name)
  846. {
  847.      if(gattr.typtr)
  848.       if(gattr.typtr == intptr)       gen0(iSQI) ;  /* integerならsqi */
  849.       else if(gattr.typtr == realptr) gen0(iSQR) ;  /* real   ならsqr */
  850.       else {
  851.        pcerr(125,name) ;                /* 標準関数の引数の型に誤り   */
  852.        gattr.typtr = intptr ;
  853.       }
  854. }
  855.  
  856. /***************************************/
  857. /*    ftrunc() : trunc関数の処理       */
  858. /***************************************/
  859. static void ftrunc(char *name)
  860. {
  861.      if(gattr.typtr)
  862.       if(gattr.typtr == realptr) gen0(iTRC) ; /* real ならtrc         */
  863.       else pcerr(125,name) ;            /* 標準関数の引数の型に誤り   */
  864.      gattr.typtr = intptr ;
  865. }
  866.  
  867. /***************************************/
  868. /*    fround() : round関数の処理       */
  869. /***************************************/
  870. static void fround(char *name)
  871. {
  872.      if(gattr.typtr)
  873.       if(gattr.typtr == realptr) gen0(iROU) ; /* real ならrou         */
  874.       else pcerr(125,name) ;            /* 標準関数の引数の型に誤り   */
  875.      gattr.typtr = intptr ;
  876. }
  877.  
  878. /***************************************/
  879. /*     fodd() : odd関数の処理          */
  880. /***************************************/
  881. static void fodd(char *name)
  882. {
  883.      if(gattr.typtr)
  884.       if(gattr.typtr == intptr) gen0(iODD) ; /* integerならodd        */
  885.       else pcerr(125,name) ;            /* 標準関数の引数の型に誤り   */
  886.      gattr.typtr = boolptr ;
  887. }
  888.  
  889. /***************************************/
  890. /*     ford() : ord関数の処理          */
  891. /***************************************/
  892. static void ford(char *name)
  893. {
  894.      if(gattr.typtr)
  895.       if((gattr.typtr->form <= subrange) /* スカラ、部分範囲型         */
  896.       && (gattr.typtr != realptr))       /* realでない時               */
  897.        convertint(gattr.typtr) ;         /* 必要ならばord命令を生成    */
  898.       else pcerr(125,name) ;             /* 標準関数の引数の型に誤り   */
  899.      gattr.typtr = intptr ;
  900. }
  901.  
  902. /***************************************/
  903. /*     fchr() : chr関数の処理          */
  904. /***************************************/
  905. static void fchr(char *name)
  906. {
  907.      if(gattr.typtr)
  908.       if(gattr.typtr == intptr) gen0(iCHR) ; /* integerなら chr命令   */
  909.       else pcerr(125,name) ;            /* 標準関数の引数の型に誤り   */
  910.      gattr.typtr = charptr ;
  911. }
  912.  
  913. /***************************************/
  914. /* fpredsucc() : pred / succ関数の処理 */
  915. /***************************************/
  916. static void fpredsucc(char *name,stdpf fkey)
  917. {
  918.    enum pcdmnc opname ;                  /* オペレーション名           */
  919.    int kind ;
  920.    long lmin,lmax ;
  921.  
  922.      if(gattr.typtr)
  923.       if((gattr.typtr->form == scalar)  /* 引数はスカラのこと         */
  924.        &&(gattr.typtr != realptr)) {    /*   ただし　real型はいけない */
  925.        getbounds(gattr.typtr,&lmin,&lmax);/* その型の上限､下限を求める*/
  926.        if(lmin==lmax)                   /* 取りえる値が1つしかない時  */
  927.         pcerr(125,name) ;               /* 標準関数の引数の型に誤り   */
  928.        if(fkey == sfSUCC) {
  929.         opname = iINC ;
  930.         kind   = 38   ;
  931.         lmax-- ;
  932.        }
  933.        else {
  934.         opname = iDEC ;
  935.         kind   = 39   ;
  936.         lmin++ ;
  937.        }
  938.        if(debug)
  939.         genchk(gattr.typtr,kind,lmin,lmax) ; /* chk命令生成           */
  940.        gen1t(opname,gattr.typtr,1) ;    /* succならinc, predならdec   */
  941.       }
  942.       else pcerr(125,name) ;            /* 標準関数の引数の型に誤り   */
  943. }
  944.  
  945. /***************************************/
  946. /* feofeoln() : eof,eoln関数の処理     */
  947. /***************************************/
  948. static void feofeoln(char *name,Set fsys,stdpf fkey)
  949. {
  950.      if(sy == lparent) {                /* 引数がある時               */
  951.       insymbol()   ;
  952.       variable(fsys) ;                  /* ファイル変数の処理         */
  953.       if(sy == rparent) insymbol() ;
  954.       else pcerr(4,"") ;                /* ) がない                   */
  955.       if(gattr.typtr)
  956.        if((gattr.typtr->form != files) ||/* 引数の型はfile型でない    */
  957.           ((fkey==sfEOLN) && (gattr.typtr!=textptr)))
  958.                                         /* eolnの時はtext型しか駄目   */
  959.        pcerr(125,name) ;                /* 標準関数の引数の型に誤り   */
  960.      }
  961.      else {                             /* 引数がない時               */
  962.       if(!defineinput) pcerr(300,name); /*  input未定義の時は駄目     */
  963.       gattr = inputattr ;
  964.      }
  965.  
  966.      if(fkey == sfEOLN)  cspfile(gattr,iEOL) ;
  967.      else                cspfile(gattr,iEOF) ;
  968.  
  969.      gattr.typtr = boolptr ;
  970. }
  971.  
  972. /***************************************/
  973. /* fcalc(): 算術関数の処理             */
  974. /***************************************/
  975. static void fcalc(char *name,stdpf fkey)
  976. {
  977.   enum pcdmnc mnc;                      /* オペレーション名           */
  978.  
  979.      if(gattr.typtr) {
  980.       if(gattr.typtr == intptr) {       /* 引数がinteger              */
  981.        gen0(iFLT) ;                     /* 引数をrealに変換           */
  982.        gattr.typtr = realptr ;
  983.       }
  984.       else if(gattr.typtr != realptr)
  985.        pcerr(125,name) ;                /* 標準関数の引数の型に誤り   */
  986.       switch(fkey) {
  987.        case sfSIN    : mnc = iSIN; break;
  988.        case sfCOS    : mnc = iCOS; break;
  989.        case sfEXP    : mnc = iEXP; break;
  990.        case sfSQRT   : mnc = iSQT; break;
  991.        case sfLN     : mnc = iLOG; break;
  992.        case sfARCTAN : mnc = iATN;
  993.       }
  994.       gen0(mnc) ;
  995.      }
  996. }
  997.  
  998. /***************************************/
  999. /* variable() : 変数引数の処理         */
  1000. /***************************************/
  1001. static void variable(Set fsys)
  1002. {
  1003.   ctp *lcp ;
  1004.   Set ws;
  1005.  
  1006.      if(sy == ident) {                  /* 引数が名前の時             */
  1007.       mkset(&ws,vars,field,-1);
  1008.       lcp = searchid(ws) ;              /* 変数､フィールド名から探す  */
  1009.       insymbol() ;
  1010.      }
  1011.      else {
  1012.       pcerr(2,"") ;                     /* 名前がない                 */
  1013.       lcp = uvarptr ;                   /* 未定義変数用の名前エリア   */
  1014.      }
  1015.      selector(fsys,lcp) ;
  1016. }
  1017.  
  1018. /*****************************************/
  1019. /* enterstdf() : 標準手続き･関数名の登録 */
  1020. /*****************************************/
  1021. void enterstdpf(void)
  1022. {
  1023.      enterstdpf_sub("write"   ,proc,nilptr,spWRITE)   ;  /* write     */
  1024.      enterstdpf_sub("writeln" ,proc,nilptr,spWRITELN) ;  /* writeln   */
  1025.      enterstdpf_sub("read"    ,proc,nilptr,spREAD)    ;  /* read      */
  1026.      enterstdpf_sub("readln"  ,proc,nilptr,spREADLN)  ;  /* readln    */
  1027.      enterstdpf_sub("page"    ,proc,nilptr,spPAGE)    ;  /* page      */
  1028.      enterstdpf_sub("get"     ,proc,nilptr,spGET)     ;  /* get       */
  1029.      enterstdpf_sub("put"     ,proc,nilptr,spPUT)     ;  /* put       */
  1030.      enterstdpf_sub("reset"   ,proc,nilptr,spRESET)   ;  /* reset     */
  1031.      enterstdpf_sub("rewrite" ,proc,nilptr,spREWRITE) ;  /* rewrite   */
  1032.      enterstdpf_sub("new"     ,proc,nilptr,spNEW)     ;  /* new       */
  1033.      enterstdpf_sub("dispose" ,proc,nilptr,spDISPOSE) ;  /* dispose   */
  1034.      enterstdpf_sub("pack"    ,proc,nilptr,spPACK)    ;  /* pack      */
  1035.      enterstdpf_sub("unpack"  ,proc,nilptr,spUNPACK)  ;  /* unpack    */
  1036.  
  1037.      enterstdpf_sub("abs"     ,func,nilptr ,sfABS)    ;  /* abs       */
  1038.      enterstdpf_sub("sqr"     ,func,nilptr ,sfSQR)    ;  /* sqr       */
  1039.      enterstdpf_sub("trunc"   ,func,intptr ,sfTRUNC)  ;  /* trunc     */
  1040.      enterstdpf_sub("round"   ,func,intptr ,sfROUND)  ;  /* round     */
  1041.      enterstdpf_sub("odd"     ,func,boolptr,sfODD)    ;  /* odd       */
  1042.      enterstdpf_sub("ord"     ,func,intptr ,sfORD)    ;  /* ord       */
  1043.      enterstdpf_sub("chr"     ,func,charptr,sfCHR)    ;  /* chr       */
  1044.      enterstdpf_sub("pred"    ,func,nilptr ,sfPRED)   ;  /* pred      */
  1045.      enterstdpf_sub("succ"    ,func,nilptr ,sfSUCC)   ;  /* succ      */
  1046.      enterstdpf_sub("eoln"    ,func,boolptr,sfEOLN)   ;  /* eoln      */
  1047.      enterstdpf_sub("eof"     ,func,boolptr,sfEOF)    ;  /* eof       */
  1048.      enterstdpf_sub("sin"     ,func,realptr,sfSIN)    ;  /* sin       */
  1049.      enterstdpf_sub("cos"     ,func,realptr,sfCOS)    ;  /* cos       */
  1050.      enterstdpf_sub("exp"     ,func,realptr,sfEXP)    ;  /* exp       */
  1051.      enterstdpf_sub("sqrt"    ,func,realptr,sfSQRT)   ;  /* sqrt      */
  1052.      enterstdpf_sub("ln"      ,func,realptr,sfLN)     ;  /* ln        */
  1053.      enterstdpf_sub("arctan"  ,func,realptr,sfARCTAN) ;  /* arctan    */
  1054.  
  1055.    /* inputファイル省略時の属性  */
  1056.      inputattr.access  = drct    ;
  1057.      inputattr.vlevel  = 1       ;
  1058.      inputattr.dplmt   = inputadr;
  1059.  
  1060.    /* outputファイル省略時の属性 */
  1061.      outputattr.access  = drct    ;
  1062.      outputattr.vlevel  = 1       ;
  1063.      outputattr.dplmt = outputadr ;
  1064. }
  1065.  
  1066. /****************************************************/
  1067. /*  enterdtdpf_sub() : 標準手続き･関数名の登録サブ  */
  1068. /****************************************************/
  1069. static void enterstdpf_sub(char *name,enum idclass pf,
  1070.                            stp *typeptr,stdpf pfid)
  1071. {
  1072.   ctp *cp ;
  1073.  
  1074.      cp = mkctp(name,pf,typeptr,nil);   /* 名前エリアを確保する       */
  1075.      cp->n.pf.pfdeckind = standard    ; /* 標準関数                   */
  1076.      cp->n.pf.sd.key    = pfid        ; /* 識別子                     */
  1077.      enterid(cp)                      ; /* 名前登録                   */
  1078. }
  1079.